home *** CD-ROM | disk | FTP | other *** search
- { This program to demonstrate the uses of the Dates unit was written by
- John Roncalio, Blue Ribbon Software, Abbotsford, B.C., Canada, V2S 4V6}
-
- PROGRAM TestDate;
- USES crt,dates;
- VAR
- AllOK:BOOLEAN;
- DS1,
- DS2 : DateString;
- Dt1,
- Dt2 : Date;
- Age : WORD;
-
- BEGIN
- ClrScr; AllOK:=False;
- Dt2:=SysDate;
- WRITELN('Today is ',DayName[DayOfWeek(Dt2)],'. The date is ',DateToDateString(Dt2));
- REPEAT
- WRITE('Enter Birth Day as MoDyYear: '); READLN(Ds1);
- Dt1:=DateStringToDate(Ds1);
- IF Dt1<>BadDate THEN AllOK:=True ELSE WRITELN('You entered an invalid date. Please try again.');
- UNTIL AllOK;
- WRITELN('That was a ',DayName[DayOfWeek(Dt1)]);
- Age:=Trunc((Dt2-Dt1) / 365.25);
- WRITE('You were ',Age,' years old ');
- WRITELN((Dt2-Dt1)-Trunc(Age*365.25),' days ago.'); WRITELN;
- WRITE('Enter some number of days hence: '); READLN(Dt1);
- Ds1:=DateToDateString(Dt1+Dt2);
- WRITELN('The date that is ',Dt1,' days from now is ',
- COPY(Ds1,1,2)+'/'+COPY(Ds1,3,2)+'/'+COPY(Ds1,5,4));
- WRITELN('That will be a ',DayName[DayOfWeek(Dt1+Dt2)]); WRITELN;
- WRITELN('These date routines are only usefull until ',DateToDateString(3652499));
- WRITELN('Sorry.');
- END.